;; extcolor.el --- minor mode for commenting source files
;; Copyright (C) 2010, 2011 Frederic Line

;; Author: Frederic Line <frederic dot line at laposte dot net>
;; Maintainer: Frederic Line <frederic dot line at laposte dot net>
;; Created: ?? ???? -- not yet released
;; Version: 1.1

;; This file is not part of GNU Emacs.

;; Extcolor is free software; you can redistribute it and/or modify it
;; under the terms  of the GNU General Public  License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; Extcolor is  distributed in  the hope that  it will be  useful, but
;; WITHOUT  ANY  WARRANTY;  without   even  the  implied  warranty  of
;; MERCHANTABILITY or  FITNESS FOR A PARTICULAR PURPOSE.   See the GNU
;; General Public License for more details.

;; You should have  received a copy of the  GNU General Public License
;; along with Extcolor; see the file COPYING.

;;; Commentary:

;;;;;;; Introduction

;; The  package  `extcolor.el'  is  used to  comment  existing  codes.
;; Mainly `extcolor.el'  lets the user paint the  interesting lines in
;; the  source   code  and  then   generates  a  code  block   in  the
;; documentation file.   Later when the  user types `C-C C-c'  in this
;; code block the related lines of the source code are colorized.  That
;; way  he can  add comments  in the  documentation file  and  see the
;; concerned lines in the source file.

;; The  package has  been developed  with `emacs'  version  22.3.1 and
;; `org-mode' (http://orgmode.org) version 7.01h.  It should work with
;; higher versions of those packages.

;; The  package `extcolor.el'  was at  the beginning  an  extension of
;; Knuth's `color.el'.  Knuth uses `color.el'  to color lines of a file
;; where he  registered the  books of his  library.  I have  found that
;; colored lines can be of  interest in many situations.  In particular
;; it  can be used  to comment  codes.  This  is what  `extcolor.el' is
;; about.

;; The package  `extcolor.el' may  be used to  comment codes  that are
;; still  actively modified  or to  comment codes  that are  no longer
;; changed.  In the first case one  uses tags that we add to the source
;; code  and  one  uses  `extcolor-string-list' to  color  the  tagged
;; lines.  In  the second case one  relies on the line  numbers and one
;; uses `extcolor-list'.

;;;;;;; Manual

;; Prior  to using `extcolor'  you need  to split  the frame  into two
;; windows  with `split-window-vertically'.  In the  first  window you
;; open the source file you want to comment.  In the second window you
;; open the documentation file.  It must be an org file.

;; The following steps must be used if you want to comment a code file
;; that no longer changes.

;; 1 - You activate the minor mode in the code file with the command
;; `M-x  extcolor-mode'.

;; 2 -  Then you need  to declare the  file name of  the documentation
;; file so that  `extcolor' knows where it must  insert the blocks you
;; will generate.   To do that  simply move to the  documentation file
;; and call `extcolor-set-org-file'.  If you want to have more than one
;; document file  you will need to  call `extcolor-set-org-file' every
;; time you change it.

;; 3  -  You   can  color  a  line  in  the   source  code  file  with
;; `extcolor-paint-line-with-color-a'          (`C-c@').           Use
;; `extcolor-paint-region-with-color-a' (`C-cr') to color a region.

;; 4 -  Then you  generate a command  block in the  documentation file
;; with   a    command   such   as   the   next    ones   by   calling
;; `extcolor-add-org-file' (`C-ca').

;; #+begin_src emacs-lisp
;;  (extcolor-mode-list "/home/ex/extcolor.el" '(161))
;; #+end_src

;; #+begin_src emacs-lisp
;;  (extcolor-mode-list "/home/ex/extcolor.el" '(244 245 246 247))
;; #+end_src

;; You need to be in the source file to call `extcolor-add-org-file'.

;; The line numbers refer to  the lines you had formerly colored.  The
;; file  name refers  to the  code file  you were  in when  you called
;; `extcolor-add-org-file'.    You  can  remove   the  path   if  your
;; documentation file is in the same directory than your source file.

;; 5 -  Now you can replay the  stored command by typing  `C-c C-c' in
;; the block.  If there are colored  lines in the source file, they are
;; unpainted.  If there are no colored lines they are painted.

;; 6  -   You  can  move  from   a  painted  line   to  another  using
;; `extcolor-first', `extcolor-next', `extcolor-previous'.

;; 7 -  You can add  a star  to your document  file with  the function
;; `extcolor-add-star' (`C-cs').  A command such as the  next one will
;; be added  to your documentation file.

;; [[/home/ex/extcolor.el::272][*]]

;; In that case the line is not painted.  Simply the cursor jumps
;; the line in the code file.

;; It is often sufficient to associate a comment to a line code and it
;; is less intrusive than a block of code with `extcolor-mode-list'.

;;; Code:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Global variables

; The custom group where all the custom variables will be located.

(defgroup extcolor nil "The extcolor minor mode." :version 1.1 ; ~3
  :group 'applications)

; 
(defcustom extcolor-mode-hook nil ; ~2
  "Hook called by function `extcolor-mode'."
  :type 'hook
  :group 'extcolor)

; This color will be used to paint the lines in the code file.
(make-empty-face 'extcolor-face-a) ; ~6

;; Parameters of `modify-face' are:
;;  foreground background stipple bold ital underline inverse
(modify-face 'extcolor-face-a nil "green" nil nil t nil nil) ; ~6

(defconst extcolor-faces ; ~5
  '(extcolor-face-a)
    "List of the faces available in extcolor mode.")

(defvar extcolor-org-file-name nil
"The name of the documentation file.")

(defvar extcolor-current-source-code nil
"The name of the source code file currently used.")

(defvar extcolor-switch nil
"A switch that says if the newt command must color or uncolor.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Initializing the system

;;;###autoload
(define-minor-mode extcolor-mode ; ~1
  "A minor mode to comment code sources.
\\{extcolor-mode-map}."
  nil ; the init value of the variable extcolor-mode.
  " Ext" ; The name of the mode that appears in the mode line.
  '(("\C-c@" . extcolor-paint-line-with-color-a) ; the mode keymap.
    ("\C-ca" . extcolor-add-org-file)
    ("\C-c\C-?" . extcolor-unpaint-line)
    ("\C-cs" . extcolor-add-star)
    ("\C-cr" . extcolor-paint-region-with-color-a)
    ([3 down] . extcolor-next)
    ([3 up] . extcolor-previous)
    ([3 home] . extcolor-first))
  :group 'extcolor
  (run-mode-hooks 'extcolor-mode-hook))

(defun extcolor-set-org-file () ; ~11
   "Set the name of the documentation file."
   (interactive)
   (setq extcolor-org-file-name (buffer-name)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Painting lines

(defun extcolor-paint-line (n) ; ~4
  "Paint the current line using the face number N of `extcolor-faces'."
  (save-excursion
    (let ((beg nil) (end nil) (ov nil))
      (beginning-of-line 1) (setq beg (point))
      (beginning-of-line 2) (setq end (point))
      (setq ov (make-overlay beg end)) ; ~8
      (overlay-put ov 'face (nth n extcolor-faces)) ; ~8
      (overlay-put ov 'extcolor-mode n)))) ; ~8

(defun extcolor-paint-line-with-color-a () ; ~7
  "Paint the current line using the face number zero of `extcolor-faces'."
  (interactive)
  (extcolor-paint-line 0))

(defun extcolor-paint-region (n) ; ~10
  "Paint the region using the face number N of `extcolor-faces'."
  (save-excursion
    (let* ((beg (region-beginning )) (end (region-end)))
      (goto-char beg)
      (while (<= (point) end)
	  (extcolor-paint-line n)
	  (forward-line)))))

(defun extcolor-paint-region-with-color-a () ; ~10
  "Paint the region using the face number zero of `extcolor-faces'."
  (interactive)(extcolor-paint-region 0))

(defun extcolor-unpaint-line () ; ~4
  "Remove the extcolor face, if any, associated with the current line."
  (interactive)
  (let* ((overlays (overlays-at (point))))
    (while overlays
      (let ((overlay (car overlays)))
	(if (overlay-get overlay 'extcolor-mode)
	    (delete-overlay overlay))
	(setq overlays (cdr overlays))))))

(defun extcolor-unpaint-all () ;~9
  "Unpaint all the lines in the buffer."
  (interactive)
  (let ((lines-number (count-lines (point-min) (point-max))) (resu `()))
    (save-excursion
      (goto-char (point-min))
      (dotimes (line-number lines-number)
	(let* ((overlays (overlays-at (point))))
	  (while overlays
	    (let ((overlay (car overlays)))
	      (if (overlay-get overlay 'extcolor-mode)
		  (delete-overlay overlay))
	      (setq overlays (cdr overlays))))
	  (forward-line))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Moving from a block of painted lines to another

(defun extcolor-first ()
  "Go to the first block of colored lines."
  (interactive)
  (let ((lines-number (count-lines (point-min) (point-max))) ; ~218
	(found nil))
    (goto-char (point-min)) ; ~219
    (dotimes (line-number lines-number) ; ~221
      (let ((overlays (overlays-at (point)))) ; ~222
	(dolist (overlay overlays)
	    (if (overlay-get overlay 'extcolor-mode) ; ~224
		(progn
		 (setq line-number lines-number) ; ~226
		 (setq found t))))) ; ~227
      (if (not found) (forward-line))))) ; ~228

(defun extcolor-next ()
  "Go to the next block of colored lines."
  (interactive)
  (let ((lines-number (count-lines (point) (point-max))) ; ~233
	(found nil)
	(former-block nil))
    (let ((overlays (overlays-at (point)))) ; ~236
      (dolist (overlay overlays)
	(if (overlay-get overlay 'extcolor-mode)
	    (setq former-block (count-lines (point-min) (point))))))
    (if (eq former-block nil) ; ~237
	(dotimes (line-number lines-number)
	  (forward-line) ; ~249
	  (let ((overlays (overlays-at (point))))
	    (dolist (overlay overlays)
	      (if (overlay-get overlay 'extcolor-mode) ; ~247
		    (setq line-number lines-number)))))
      (dotimes (line-number lines-number) ; ~251
	(forward-line) ; ~256
	(let ((overlays (overlays-at (point))))
	  (dolist (overlay overlays)
	    (if (overlay-get overlay 'extcolor-mode)
		(if (eq (- (count-lines (point-min) (point))
			   former-block) 1) ; ~258
		    (setq former-block (+ former-block 1)) ; ~259
		  (setq line-number lines-number))))))))) ; ~260

(defun exist (list prop)
  "Return true if there is an element in LIST which has the property PROP."
  (let ((found nil))
    (dolist (x list)
      (if prop
	(setq list nil found t)))
    found))

(defun extcolor-previous ()
  "Go to the previous block of colored lines."
  (interactive)
  (let ((lines-number (count-lines (point-min) (point))) ; ~prev1
	(found nil)
	(blockA nil))
    ; Does line L have an overlay ?
    (let ((overlays (overlays-at (point))))
      (dolist (overlay overlays)
	(if (overlay-get overlay 'extcolor-mode)
	    (setq blockA (count-lines (point-min) (point))))))  ; ~prev2
    ; Look for the last line of the previous colored block.
    (if (eq blockA nil) ; ~prev3
	(dotimes (line-number lines-number)
	  (forward-line -1) ; ~prev4
	  (let ((overlays (overlays-at (point))))
	    (dolist (overlay overlays)
	      (if (overlay-get overlay 'extcolor-mode) ; ~prev5
		    (setq line-number lines-number found t)))))
      (dotimes (line-number lines-number)
	(forward-line -1) ; ~prev7
	(let ((overlays (overlays-at (point))))
	  (dolist (overlay overlays)
	    (if (overlay-get overlay 'extcolor-mode) ; ~prev8
		(if (eq (- blockA (count-lines (point-min) (point))) 1) ;~prev8a
		    (setq blockA (- blockA 1)) ; ~prev9
		  (setq line-number lines-number found t))))))) ; ~prev10
    ; If the block has been found, look for the first line of the block.
    (if (eq found t) ; ~prev11
	(let ((lines-number (count-lines (point-min) (point))))
	  (dotimes (line-number lines-number)
	    (if (not (eq line-number 1))
		(progn
		  (forward-line -1) ; ~prev12
		  (if (not (exist (overlays-at (point))
				  `(overlay-get x 'extcolor-mode))) ; ~prev13
		      (progn
			(forward-line) ; ~prev14
			(setq line-number lines-number)))))))))) ; ~prev15

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Generating a command block

(defun extcolor-numbered-lines (buf)
  "Return a list of the colored lines in the current buffer.
Argument BUF is the buffer you want to examin."
  (with-current-buffer buf
    (let ((lines-number (count-lines (point-min) (point-max))) (resu `()))
      (save-excursion
	(goto-char (point-min))
	(dotimes (line-number lines-number)
	  (let* ((overlays (overlays-at (point))))
	    (while overlays
	      (let ((overlay (car overlays)))
		(if (overlay-get overlay 'extcolor-mode)
		    (setq resu (cons ( + line-number 1 ) resu))))
	      (setq overlays (cdr overlays))))
	  (forward-line))
	    resu))))

(defun extcolor-add-org-file ()
  "Add a command block to the documentation file.
The purpose of this command is to paint again the colored lines
when exercised by the user later."
  (interactive)
  (let ((buf (current-buffer))(buf-name (buffer-file-name)))
   (with-current-buffer extcolor-org-file-name
     (insert "#+begin_src emacs-lisp\n (color-list ")
     (insert "\"")
     (insert buf-name)
     (insert "\" '")
     (insert (prin1-to-string (reverse (extcolor-numbered-lines buf))))
     (insert ")\n#+end_src\n"))))

(defun extcolor-list (buf lines)
  "The command generated by `extcolor-org-file' will call this function.
Argument BUF is the buffer you want to treat.
Argument LINES are the lines you want to color in the buffer BUF."
  (interactive)
  (with-current-buffer (find-file-other-window buf)
      (cond
       ((eq extcolor-switch nil)
	(setq extcolor-switch t)
	(setq extcolor-current-source-code buf)
	(dolist (line lines)
	  (goto-char (point-min)) (forward-line (1- line))
	  ; (goto-line line)
	  (extcolor-paint-line 0)))
       ((eq extcolor-switch t)
	(setq extcolor-switch nil)
	(extcolor-unpaint-all)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Using tags to comment.

(defun extcolor-string-list (buf lines)
  "Command called by the command block generated in the documentation file.
It will paint againt the lines of the buffer BUF listed in LINES."
  (with-current-buffer (find-file-other-window buf)
      (cond
       ((eq extcolor-switch nil)
	(setq extcolor-switch t)
	(setq extcolor-current-source-code buf)
	(dolist (line lines)
	  (goto-char (point-min))
	  (while (not (eobp))
	    (search-forward (concat "~" (number-to-string line)))
	    (extcolor-paint-line 0))))
       ((eq extcolor-switch t)
	(setq extcolor-switch nil)
	(extcolor-unpaint-all)))))

(defun extcolor-hundred ()
  "Helper used by `extcolor-all-string-list."
     (let (value)      ; otherwise a value is a void variable
       (dotimes (number 100 value)
         (setq value (cons number value)))))

(defun extcolor-all-string-list ()
  "Color all the string lists."
  (interactive)
  (save-excursion
  (let ((lines (extcolor-hundred)))
	(dolist (line lines)
	  (goto-char (point-min))
	  (while (not (eobp))
	    (if (search-forward
		      (concat "~" (number-to-string line)) (point-max) t)
	    (extcolor-paint-line 1))
	    (forward-line))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Using a star to comment.

(defun extcolor-add-star ()
  "Insert a button in the documentation file.
This button will jump to a line in the code file when exercised later."
  (interactive)
  (let ((buf (buffer-file-name)) (line (number-to-string (line-number-at-pos))))
    (with-current-buffer extcolor-org-file-name
      (insert "([[")
      (insert buf)
      (insert "::")
      (insert line)
      ; Be careful the buffer musn't be narrowed.
      (insert "][*]])"))))


(provide 'extcolor)

;;; extcolor.el ends here
